home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-08-10 | 10.4 KB | 320 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- StampElems
- Alloc
- 10 Aug 95
- Syntax10b.Scn.Fnt
- Syntax10m.Scn.Fnt
- MODULE IndexElems; (* mah
- IMPORT
- Display, Input, Files, Fonts, Printer, Oberon, Texts, Viewers, MenuViewers, TextFrames, TextPrinter, MarkElems, LinkElems;
- CONST
- middleKey = 1;
- Height = 8*TextFrames.Unit;
- Width = 13*TextFrames.Unit;
- TYPE
- Elem* = POINTER TO ElemDesc;
- ElemDesc* = RECORD(MarkElems.ElemDesc)
- text*: Texts.Text;
- visible, empty: BOOLEAN;
- pno-: INTEGER;
- next: Elem;
- END;
- EditFrame = POINTER TO EditFrameDesc;
- EditFrameDesc = RECORD (TextFrames.FrameDesc)
- elem: Elem
- END;
- w: Texts.Writer;
- elems: Elem;
- icon, invIcon: Display.Pattern; (* x = 0, y = -curfnt.minY, w = 13, h = 8 *)
- PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
- VAR p: TextFrames.Parc; beg: LONGINT;
- BEGIN
- IF f = NIL THEN
- IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
- ELSE
- TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
- dsr := SHORT(p.dsr DIV TextFrames.Unit)
- END
- END GetDsr;
- PROCEDURE CopyText (T: Texts.Text): Texts.Text;
- VAR t: Texts.Text; buf: Texts.Buffer;
- BEGIN
- NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf);
- t := TextFrames.Text(""); Texts.Append(t, buf); RETURN t
- END CopyText;
- PROCEDURE HandleEdit (F: Display.Frame; VAR M: Display.FrameMsg);
- VAR F1: EditFrame;
- BEGIN
- TextFrames.Handle (F, M);
- WITH F: EditFrame DO
- IF M IS Oberon.CopyMsg THEN
- NEW(F1); TextFrames.Open(F1, F.text, F.org);
- F1.handle := F.handle; F1.elem := F.elem; M(Oberon.CopyMsg).F := F1
- END
- END
- END HandleEdit;
- PROCEDURE OpenEditor (E: Elem);
- VAR V: Viewers.Viewer; F: EditFrame; x, y: INTEGER;
- BEGIN
- IF E.empty THEN E.text := TextFrames.Text ("") END;
- Oberon.AllocateUserViewer (Oberon.Mouse.X, x, y);
- NEW(F); F.elem := E; TextFrames.Open (F, CopyText(E.text), 0); F.handle := HandleEdit;
- V := MenuViewers.New (TextFrames.NewMenu("Index Entry",
- "System.Close System.Copy System.Grow IndexElems.Update "),
- F, TextFrames.menuH, x, y)
- END OpenEditor;
- PROCEDURE MarkedFrame (VAR name: ARRAY OF CHAR): TextFrames.Frame;
- VAR V: Viewers.Viewer; S: Texts.Scanner;
- BEGIN V := Oberon.MarkedViewer ();
- IF (V#NIL) & (V IS MenuViewers.Viewer) & (V.dsc.next IS TextFrames.Frame) THEN
- Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0); Texts.Scan(S);
- COPY( S.s, name); RETURN V.dsc.next(TextFrames.Frame)
- ELSE RETURN NIL
- END
- END MarkedFrame;
- PROCEDURE Copy (SE, DE: Elem);
- BEGIN
- Texts.CopyElem(SE, DE); DE.key := SE.key;
- DE.visible := TRUE; DE.text := CopyText (SE.text)
- END Copy;
- PROCEDURE Edit (E: Elem; x0, y0, dsr: INTEGER; keysum: SET);
- VAR w, h, x, y: INTEGER; keys: SET;
- BEGIN
- IF keysum = {middleKey} THEN
- w := SHORT (E.W DIV TextFrames.Unit); h := SHORT (E.H DIV TextFrames.Unit);
- Oberon.RemoveMarks (x0, y0, w, h);
- Display.CopyPattern(Display.white, icon, x0, y0 + dsr, Display.invert);
- Display.CopyPattern(Display.white, invIcon, x0, y0 + dsr, Display.invert);
- REPEAT Input.Mouse (keys, x, y); keysum := keysum + keys;
- Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
- UNTIL keys = {};
- Display.CopyPattern(Display.white, invIcon, x0, y0 + dsr, Display.invert);
- Display.CopyPattern(Display.white, icon, x0, y0+ dsr, Display.invert);
- IF keysum = {middleKey} THEN OpenEditor (E) END
- END
- END Edit;
- PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
- VAR e: Elem; pos: LONGINT; w, h, dsr: INTEGER; keys, keysum: SET;
- BEGIN
- WITH E: Elem DO
- WITH msg : TextFrames.DisplayMsg DO
- WITH msg: TextFrames.DisplayMsg DO
- IF ~msg.prepare THEN
- GetDsr (msg.frame, msg.pos, msg.fnt, dsr);
- IF E.visible THEN Display.CopyPattern(Display.white, icon, msg.X0, msg.Y0 + dsr, Display.paint) END
- ELSE
- GetDsr (msg.frame, msg.pos, msg.fnt, msg.Y0); E.W := Width;
- IF E.visible THEN E.H := 8 * TextFrames.Unit ELSE E.H := 0 END
- END
- END
- | msg : Texts.IdentifyMsg DO
- msg.mod:="IndexElems"; msg.proc:="Alloc"
- | msg : Texts.CopyMsg DO
- NEW(e); Copy (E, e); msg(Texts.CopyMsg).e := e;
- | msg : TextFrames.TrackMsg DO
- GetDsr (msg.frame, msg.pos, msg.fnt, dsr);
- Edit(E, msg.X0, msg.Y0, dsr, msg.keys)
- | msg : Texts.FileMsg DO
- IF msg.id = Texts.load THEN
- Files.ReadBool (msg.r, E.visible); Files.ReadBool (msg.r, E.empty);
- E.text := TextFrames.Text (""); Texts.Load (msg.r, E.text)
- ELSIF msg.id = Texts.store THEN
- Files.WriteBool (msg.r, E.visible); Files.WriteBool (msg.r, E.empty);
- Texts.Store (msg.r, E.text)
- END
- | msg : TextPrinter.PrintMsg DO
- IF msg.prepare THEN E(Elem).pno := msg.pno; E.W := 0 END
- ELSE
- END
- END
- END Handle;
- PROCEDURE Alloc*;
- VAR e: Elem;
- BEGIN NEW(e); e.handle:=Handle; Texts.new:=e
- END Alloc;
- PROCEDURE Insert*;
- e: Elem; insert: TextFrames.InsertElemMsg;
- t: Texts.Text; buf: Texts.Buffer; start, end, time: LONGINT;
- BEGIN
- Oberon.GetSelection(t, start, end, time);
- NEW (e); e.text := TextFrames.Text ("");
- e.handle := Handle; e.visible := TRUE; e.key := Oberon.Time ();
- e.H := Height; e.W := Width;
- IF time >= 0 THEN
- NEW(buf); Texts.OpenBuf(buf);
- Texts.Save(t, start, end, buf); Texts.Append(e.text, buf)
- ELSE e.empty := TRUE
- END;
- insert.e := e; Viewers.Broadcast (insert)
- END Insert;
- PROCEDURE Hide*;
- VAR f: TextFrames.Frame; pos: LONGINT; r: Texts.Reader; name: ARRAY 256 OF CHAR;
- BEGIN
- f := MarkedFrame (name);
- Texts.OpenReader (r, f.text, 0); Texts.ReadElem (r);
- WHILE ~r.eot DO
- IF r.elem IS Elem THEN
- r.elem(Elem).visible := FALSE; pos := Texts.ElemPos (r.elem); r.elem.W := 0;
- TextFrames.NotifyDisplay(f.text, Texts.replace, pos, pos+1)
- END;
- Texts.ReadElem (r)
- END
- END Hide;
- PROCEDURE Show*;
- VAR f: TextFrames.Frame; pos: LONGINT; r: Texts.Reader; name: ARRAY 256 OF CHAR;
- BEGIN
- f := MarkedFrame (name);
- Texts.OpenReader (r, f.text, 0); Texts.ReadElem (r);
- WHILE ~r.eot DO
- IF r.elem IS Elem THEN
- r.elem(Elem).visible := TRUE; pos := Texts.ElemPos (r.elem);
- r.elem.W := Width;
- TextFrames.NotifyDisplay(f.text, Texts.replace, pos, pos+1)
- END;
- Texts.ReadElem (r)
- END
- END Show;
- PROCEDURE Update*;
- VAR f: EditFrame; s: Texts.Scanner; menuText, text: Texts.Text; e: Elem; pos: LONGINT;
- BEGIN
- IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
- f := Oberon.Par.frame.next(EditFrame); e := f.elem;
- IF f.text.len # 0 THEN e.text := CopyText(f.text); e.empty := FALSE ELSE e.empty := TRUE END;
- menuText := Oberon.Par.frame(TextFrames.Frame).text;
- Texts.OpenReader (s, menuText, menuText.len-1); Texts.Read (s, s.c);
- IF s.c = "!" THEN Texts.Delete (menuText, menuText.len-1, menuText.len) END
- END
- END Update;
- PROCEDURE CharDiff (c1, c2: CHAR) : INTEGER;
- BEGIN
- IF (c1 = '
- ') OR (c1 = '
- ') THEN c1 := 'o' END;
- IF (c1 = '
- ') OR (c1 = '
- ') THEN c1 := 'u' END;
- IF (c1 = '
- ') OR (c1 = '
- ') THEN c1 := 'a' END;
- IF (c2 = '
- ') OR (c2 = '
- ') THEN c2 := 'o' END;
- IF (c2 = '
- ') OR (c2 = '
- ') THEN c2 := 'u' END;
- IF (c2 = '
- ') OR (c2 = '
- ') THEN c2 := 'a' END;
- RETURN ORD (CAP (c1)) - ORD (CAP (c2))
- END CharDiff;
- PROCEDURE CompareTexts (t1, t2: Texts.Text) : INTEGER; (* t1-t2 *)
- VAR r1, r2: Texts.Reader; ch1, ch2: CHAR; diff: INTEGER;
- BEGIN
- Texts.OpenReader(r1, t1, 0); Texts.OpenReader(r2, t2, 0);
- REPEAT Texts.Read (r1, ch1); Texts.Read (r2, ch2); diff := CharDiff (ch1, ch2);
- UNTIL r1.eot OR r2.eot OR (diff # 0);
- IF r1.eot & r2.eot THEN RETURN 0
- ELSIF r1.eot THEN RETURN -1
- ELSIF r2.eot THEN RETURN 1
- ELSE RETURN diff
- END
- END CompareTexts;
- PROCEDURE Sort;
- VAR e, sb, s, sorted: Elem;
- BEGIN
- sorted := elems;
- elems := elems.next;
- sorted.next := NIL;
- WHILE elems # NIL DO
- e := elems; elems := elems.next;
- IF CompareTexts (sorted.text, e.text) >= 0 THEN e.next := sorted; sorted := e
- ELSE
- sb := sorted; s:= sorted.next;
- WHILE (s # NIL) & (CompareTexts (s.text, e.text) < 0) DO
- sb := s; s := s.next
- END;
- e.next := sb.next; sb.next := e
- END
- END;
- elems := sorted
- END Sort;
- PROCEDURE BuildText (e: Elem; t: Texts.Text; pos: LONGINT);
- VAR s: Texts.Scanner;
- BEGIN
- e.text := TextFrames.Text ("");
- Texts.OpenScanner (s, t, pos+1); Texts.Scan (s);
- IF (s.class = Texts.String) OR (s.class = Texts.Name) THEN
- Texts.WriteString (w, s.s); Texts.Append (e.text, w.buf)
- END
- END BuildText;
- PROCEDURE Index*;
- V : Viewers.Viewer;
- res, X, Y : INTEGER;
- text: Texts.Text;
- f: TextFrames.Frame;
- r: Texts.Reader;
- buf: Texts.Buffer;
- e, ee: Elem;
- name: ARRAY 256 OF CHAR;
- BEGIN
- f := MarkedFrame (name);
- text := TextFrames.Text ("");
- Oberon.Call ("Edit.Print", Oberon.Par, FALSE, res);
- Texts.OpenReader(r, f.text, 0); Texts.ReadElem(r);
- WHILE ~ r.eot DO
- IF r.elem IS Elem THEN
- IF r.elem(Elem).empty THEN BuildText (r.elem(Elem), f.text, Texts.ElemPos (r.elem)) END;
- r.elem(Elem).next := elems; elems := r.elem(Elem)
- END;
- Texts.ReadElem(r)
- END;
- Sort (); e:=elems;
- WHILE e # NIL DO
- NEW(buf); Texts.OpenBuf(buf);
- Texts.Save(e.text, 0, e.text.len, buf); Texts.Append (text, buf);
- Texts.Write (w, 9X); Texts.WriteInt (w, e.pno, 0);
- Texts.WriteElem (w, LinkElems.New (name, e.key));
- WHILE (e.next # NIL) & (CompareTexts (e.text, e.next.text) = 0) DO
- IF e.pno # e.next.pno THEN
- Texts.WriteString (w, ", "); Texts.WriteInt (w, e.next.pno, 0)
- END;
- Texts.WriteElem (w, LinkElems.New (name, e.next.key));
- e := e.next
- END;
- Texts.WriteLn (w);
- Texts.Append (text, w.buf);
- e := e.next
- END;
- e := elems; WHILE e # NIL DO ee := e.next; e.next := NIL; e := ee END; elems := NIL;
- Oberon.AllocateUserViewer (0, X, Y);
- V := MenuViewers.New (
- TextFrames.NewMenu ("IndexElems.Index", "^Edit.Menu.Text"),
- TextFrames.NewText (text, 0),
- TextFrames.menuH,
- X, Y)
- END Index;
- PROCEDURE InitIcon;
- VAR line: ARRAY 9 OF SET;
- BEGIN
- line[1] := {4..8};
- line[2] := {3, 9};
- line[3] := {2, 5..7, 10};
- line[4] := {2, 6, 10};
- line[5] := {2, 6, 10};
- line[6] := {2, 5..7, 10};
- line[7] := {3, 9};
- line[8] := {4..8};
- icon := Display.NewPattern(line, 13, 8);
- line[1] := {4..8};
- line[2] := {3..9};
- line[3] := {2..4, 8..10};
- line[4] := {2..5, 7..10};
- line[5] := {2..5, 7..10};
- line[6] := {2..4, 8..10};
- line[7] := {3..9};
- line[8] := {4..8};
- invIcon := Display.NewPattern(line, 13, 8)
- END InitIcon;
- BEGIN Texts.OpenWriter (w); InitIcon
- END IndexElems.
-